Acorn User: China/Acorn User China CD-ROM (UK) (Disc B)/Acorn User China CD-ROM (UK) (Disc B).bin/STUTTGART/EDITORS/FUE/ue_mac_rc2

Text File | 1991-04-08 | 22.2 KB | 850 lines

; Andy Sturges : These are my standard macros

;{{{  store-procedure help
store-procedure help
        !if %rcfkeys
                !goto rcfoff
        !endif

;       toggle function key window on
        save-window
        1 next-window
        !if &sequal $cbufname "emacs.hlp"
                delete-window
        !endif
        !if ¬ &sequal $cbufname "Function Keys"
                1 split-current-window
                1 select-buffer "Function Keys"
                end-of-file
                !force $curline resize-window
                1 goto-line
        !endif
        set %rcfkeys TRUE
        !force restore-window
        !if &sequal $cbufname "Function Keys"
                next-window
        !endif
        write-message "[Function key window ON]"
        !return

        ;Toggle the function key window off
*rcfoff
        save-window
        1 next-window
        !if &sequal "Function Keys" $cbufname
                delete-window
        !endif
        !force restore-window
        write-message "[Function key window OFF]"
        set %rcfkeys FALSE
!endm
;}}}
;{{{  store-procedure do-pick-line
store-procedure do-pick-line
        set $curcol $lmargin
        set-mark
        next-line
        kill-region
        set $curcol $lmargin
        set %tmp $cwline
        set %main $cbufname
        1 select-buffer %pick
        yank
        unmark-buffer
        select-buffer %main
        goto-mark
        !if &and &seq $progname "uEmacs"  &seq $ltype LSOEFOLD
        close-fold
          set $curcol $lmargin
        !endif
!endm
;}}}
;{{{  store-procedure do-put-buffer
store-procedure do-put-buffer
        set %main $cbufname
        1 select-buffer %pick
        beginning-of-file
        set-mark
        end-of-file
        !force backward-character
        copy-region
        unmark-buffer
        select-buffer %main
        !force previous-line
        end-of-line
        open-line
        next-line
        yank
        delete-next-character
        previous-line
        set $curcol $lmargin
        delete-buffer %pick
!endm
;}}}
;{{{  store-procedure clear-pick
store-procedure clear-pick
        delete-buffer "?pick?"
        write-message "[pick buffer cleared]"
!endm
;}}}
;{{{  store-procedure pick-line
store-procedure pick-line
  set %pick "?pick?"
  execute-procedure do-pick-line
  write-message "[line moved to pick buffer]"
!endm
;}}}
;{{{  store-procedure move-line
store-procedure move-line
        set %pick "?move?"
        !if %moving
                execute-procedure do-put-buffer
                delete-buffer "?move?"
                set %moving FALSE
                write-message "[line put]"
        !else
                delete-buffer "?move?"
                execute-procedure do-pick-line
                set %moving TRUE
                write-message "[line moved to pick buffer]"
        !endif
!endm
;}}}
;{{{  store-procedure copy-pick
store-procedure copy-pick
        set $curcol $lmargin
        set-mark
        next-line
        copy-region
        set $curcol $lmargin
        set %tmp $cwline
        set %main $cbufname
        1 select-buffer "?pick?"
        yank
        unmark-buffer
        select-buffer %main
        goto-mark
        !if &and &seq $progname "uEmacs"  &seq $ltype LSOEFOLD
        close-fold
        !endif
        next-line
        write-message "[line copied to pick buffer]"
!endm
;}}}
;{{{  store-procedure put-buffer
store-procedure put-buffer
  set %pick "?pick?"
  execute-procedure do-put-buffer
  write-message "[pick buffer put]"
!endm

;}}}
;{{{  store-procedure copy-line
store-procedure copy-line
        set $curcol $lmargin
        set-mark
        next-line
        copy-region
        newline
        previous-line
        yank
        delete-next-character
        previous-line
        write-message "[line copied]"
!endm

;}}}
;{{{  store-procedure del-line
store-procedure delete-line
        set $curcol $lmargin
        set-mark
        next-line
        kill-region
        write-message "[line deleted]"
!endm

;}}}
;{{{  store-procedure pick-region
store-procedure pick-region
        copy-region
        set $curcol $lmargin
        set %tmp $cwline
        set %main $cbufname
        1 select-buffer "?pick?"
        yank
        unmark-buffer
        select-buffer %main
        write-message "[region copied to pick buffer]"
!endm
;}}}


!if &seq $progname "uEmacs"
  set %t-depth 0
  ;{{{  store-procedure copy-to-fold
  store-procedure copy-to-fold
          set $curcol $lmargin
          !force enter-fold
          !if $status
                  kill-to-end-of-line
                  yank
                  exit-fold
                  5 forward-character
                  yank
                  !if ¬ &equal $curchar 13
                          kill-to-end-of-line
                  !endif
          !endif
  !endm
  ;}}}
  ;{{{  store-procedure t-sa
  store-procedure t-sa
          !if &and ¬ &seq $cfname "" &bor $cbflags 2
          save-file
          !endif
          set %tmp $cbufname
          next-buffer
          !while ¬ &seq $cbufname %tmp
                  !if &and ¬ &seq $cfname "" &bor $cbflags 2
                          save-file
                  !endif
                  next-buffer
          !endwhile
          !if %t-lstflg
                  execute-procedure t-listbuf
          !endif
          set $discmd TRUE
          set $disinp TRUE
          write-message "[All buffers saved]"
  !endm

  ;}}}
  ;{{{  store-procedure t-listbuf
  store-procedure t-listbuf
          save-window
          !if ¬ %t-lstflg
            split-current-window
          !endif
          list-buffers
          set %t-lstflg TRUE
          !while ¬ &seq $cbufname "[List]"
                  next-window
                  set %nwins &sub %nwins 1
          !endwhile
          beginning-of-file
          set-mark
          set $curline 4
          kill-region
          !while $status
                  !force set $curcol 2
                  !force set-mark
                  !force set $curcol 22
                  !force kill-region
                   !force next-line
          !endwhile
          $curline resize-window
          add-mode MAGIC
          beginning-of-file
          restore-window
          set $discmd TRUE
          set $disinp TRUE
  !endm

  ;}}}
  ;{{{  store-procedure t-listbufoff
  store-procedure t-listbufoff
          set %tmp 100
          set %t-lstflg FALSE
          save-window
          !while &and ¬ &seq $cbufname "[List]" %tmp
                  next-window
                  set %tmp &sub %tmp 1
          !endwhile
          !if &seq $cbufname "[List]"
            delete-window
          !endif
          restore-window
          set $discmd TRUE
          set $disinp TRUE
  !endm

  ;}}}
  ;{{{  store-procedure t-delbuf
  store-procedure t-delbuf
          !if &seq $cbufname "[List]"
                  set %tmp $search
                  !force set $curcol 2
                  search-forward "[^ ]*"
                  set $search %tmp
                  set $discmd TRUE
                  set $disinp TRUE
                  !force delete-buffer $match
                  restore-window
                  save-window
                  !if $status
                          execute-procedure t-listbuf
                          write-message "[Buffer deleted]"
                  !endif
          !endif
  !endm

  ;}}}
  ;{{{  store-procedure t-gotobuf
  store-procedure t-gotobuf
          !if &seq $cbufname "[List]"
                  set %tmp $search
                  !force set $curcol 2
                  search-forward "[^ ]*"
                  set $search %tmp
                  restore-window
                  set %tmp $cbufname
                  !force next-buffer
                  !while &and ¬ &seq $cbufname %tmp ¬ &seq $cbufname $match
                          next-buffer
                  !endwhile
                  !if &seq $cbufname $match
                          set $discmd TRUE
                          set $disinp TRUE
                          write-message "[Buffer found]"
                  !endif
          !endif
  !endm

  ;}}}
  ;{{{  store-procedure t-bufname
  store-procedure t-bufname
          set %tmp $cbufname
          set %string $cfname
          1 select-buffer ".uetooltmp"
          insert-string %string
          write-file ".uetooltmp"
          select-buffer %tmp
          !force delete-buffer ".uetooltmp"
  !endm

  ;}}}
  ;{{{  store-procedure t-filepsn
  store-procedure t-filepsn
          !force set %fpsn @""
          end-of-file
          goto-line &DIV &TIMES $curline %fpsn 1000
  !endm

  ;}}}
  ;{{{  store-procedure t-spell
  store-procedure t-spell
          save-file
          shell-command &cat "ispelltool " $cfname
          read-file $cfname
  !endm

  ;}}}
  ;{{{  store-procedure t-maketags
  store-procedure t-maketags
          set $discmd TRUE
          set $disinp TRUE
          3 set-mark
          set %occ ¬ &equal &sin $cfname ".occ" 0
          set %base 0
          set %tmp &sin $cfname "/"
          !while ¬ &equal %tmp 0
            set %base &add %base %tmp
            set %tmp &sin &right $cfname &sub &length $cfname %base "/"
          !endwhile

          set %home &left $cfname %base
          set %tagf &cat %home ".uetags"

          set %tmpbuf  $cbufname
          1 select-buffer &right %tagf 32
          write-message &cat &cat "[creating " %tagf " file ...]"
          !if %occ
                  !force set %cmd &cat &cat "octags -f " %tagf &cat " " &cat %home "*.[opi][cgn][cm]"
                  !force shell-command %cmd
          !else
                  !force shell-command &cat &cat "ctags -t -w -f " %tagf &cat " " &cat %home "*.[ch]"
          !endif
          !force read-file %tagf
          !force add-mode magic
          select-buffer %tmpbuf
  !endm

  ;}}}
  ;{{{  store-procedure t-ctags
  store-procedure t-ctags
    ;set $debug TRUE
    ;{{{  init
    3 set-mark

    set %tdebug $debug
    set $debug FALSE
    set %occ ¬ &equal &sin $cfname ".occ" 0
    set %base 0
    set %tmp &sin $cfname "/"
    !while ¬ &equal %tmp 0
      set %base &add %base %tmp
      set %tmp &sin &right $cfname &sub &length $cfname %base "/"
    !endwhile

    set %home &left $cfname %base

    set %tagf &cat %home ".uetags"

    set %tmp     $search
    set %tmode   $cmode
    set %tmpbuf  $cbufname
    !force add-mode magic
    set $debug %tdebug

    ;}}}
    ;{{{  find tag
    1 forward-character   ; If we are on the first char
    !if %occ
            !force search-reverse "[a-zA-Z][a-zA-Z0-9.]*"
            !force search-forward "[a-zA-Z][a-zA-Z0-9.]*"
    !else
            !force search-reverse "[a-zA-Z][a-zA-Z0-9_]*"
            !force search-forward "[a-zA-Z][a-zA-Z0-9_]*"
    !endif
    !if &seq $status FALSE
            !goto tagfail
    !endif
    set %string $match
    ;}}}
    ;{{{  read tag file
    ;set $debug TRUE
    1 select-buffer &right %tagf 32
    !if &seq $cfname ""
            !if ¬ &exi %tagf
                    write-message &cat &cat "[creating " %tagf " file ...]"
                    !if %occ
                            !force set %cmd &cat &cat "octags -f " %tagf &cat " " &cat %home "*.[opi][cgn][cm]"
                            ;" &cat &cat %home "*.inc " &cat %home "*.pgm"
                            shell-command %cmd
                    !else
                            shell-command &cat &cat "ctags -t -w -f " %tagf &cat " " &cat %home "*.[ch]"
                    !endif
            !endif
            read-file %tagf
            !force add-mode magic
            1 select-buffer &right %tagf 32
    !endif
    beginning-of-file
    ;}}}
    !force search-forward &cat &cat "^" %string "~t"
    !if &seq $status TRUE
      ;{{{  look for source file
      set-mark
      search-forward "~t" ; Tab char
      1 backward-character
      copy-region
      set %fname $kill
      search-forward "~t" ; Tab char
      !if &equ $curchar 47
        ;{{{  use search string
        2 forward-character
        set-mark
        end-of-line
        2 backward-character
        copy-region
        set %string $kill
        !if &seq $cbufname &right %tagf 32
          find-file %fname
        !endif
        !if &seq $progname "uEmacs"
          !force exit-all-folds
        !endif
        beginning-of-file
        !force add-mode magic
        !if &seq $progname "uEmacs"
          !force searchfold-forward %string
        !else
          !force search-forward %string
        !endif

        !if &seq $status FALSE
          !goto tagfail
        !endif
        ;}}}
      !else
        ;{{{  goto line number
        set-mark
        end-of-line
        copy-region
        set %string $kill
        !if &seq $cbufname &right %tagf 32
          find-file %fname
        !endif
        !if &seq $progname "uEmacs"
          !force exit-all-folds
        !endif
        beginning-of-file
        !force goto-line %string
        !if &seq $status FALSE
          !goto tagfail
        !endif
        ;}}}
      !endif
      ;}}}
    !else
      !goto tagfail
    !endif
    set $search %tmp
    set $debug FALSE
    set $discmd TRUE
    set $disinp TRUE
    write-message "[tag found]"
    !return
  *tagfail
    select-buffer %tmpbuf
    set $cmode %tmode
    set $search %tmp
    3 goto-mark
    set $debug FALSE
    set $discmd TRUE
    set $disinp TRUE
    write-message "[tag not found]"
  !endm

  ;}}}
  ;{{{  store-procedure t-cleartags
  store-procedure t-cleartags
    delete-buffer ".uetags"
  !endm
  ;}}}
  ;{{{  store-procedure t-sethome
  store-procedure t-sethome
    set %base 0
    set %tmp &sin $cfname "/"
    !while ¬ &equal %tmp 0
      set %base &add %base %tmp
      set %tmp &sin &right $cfname &sub &length $cfname %base "/"
    !endwhile
    set %home &left $cfname %base
  !endm
  ;}}}
  ;{{{  store-procedure t-findname
  store-procedure t-findname
    ;{{{  look for include etc
    set %psn &sindex $line "#INCLUDE"
    set %mst FALSE
    set %occ FALSE
    !if %psn
      set %occ TRUE
    !else
      set %psn &sindex $line "#EXPAND"
      !if %psn
        set %mst TRUE
      !else
        set %psn &sindex $line "#include"
      !endif
    !endif
    ;}}}
    !if %psn
      set $curcol %psn
      add-mode magic
      search-forward "[~"<]"
      search-forward "[^~">~n]*"
      set %fname &cat %home $match
      !if %mst
        set %fname &cat %fname ".mst"
      !endif
    !else
      set %fname ""
    !endif
  !endm
  ;}}}
  ;{{{  store-procedure t-enter-filed
  store-procedure t-enter-filed
    ;{{{  save state
    set %tmps    $search
    set %tmode   $cmode
    set %tmpbuf  $cbufname
    2 set-mark
    set %saveb   $cbufname
    ;}}}
    ;set %occ  &or ¬ &equal &sin $cfname ".occ" 0 ¬ &equal &sin $cfname ".inc" 0
    ;set %mst  ¬ &equal &sin $cfname ".mst" 0
    !if &equal t-depth 0
      execute-procedure t-sethome
    !endif
    set %tmpf $cfname
    execute-procedure t-findname
    !if &seq %fname ""
      ;{{{  not a filed fold
      set $search %tmps
      set $cmode %tmode
      2 goto-mark
      write-message "[Not a filed fold]"
      ;}}}
    !else
      !force find-file %fname
      !if $status
        ;{{{  enter file
        1 select-buffer ?filed
        beginning-of-file
        insert-string &cat &cat "+" %fname &cat " " %tmpf
        newline
        unmark-buffer
        !force find-file %fname
        !if %t-lstflg
          execute-procedure t-listbuf
        !endif
        set $search %tmps
        set $cmode %tmode
        set %t-depth &add %t-depth 1
        write-message "[File entered]"
        ;}}}
      !else
        ;{{{  error
        select-buffer %tmpbuf
        !force delete-buffer %fname
        set $search %tmps
        set $cmode %tmode
        write-message "[Failed to enter file]"
        ;}}}
      !endif
    !endif
  !endm
  ;}}}
  ;{{{  store-procedure t-unfiled
  store-procedure t-unfiled
    set %tmps     $search
    set %tmode   $cmode
    set %tmpbuf  $cbufname
    2 set-mark
    set %saveb $cbufname
    !if &equal t-depth 0
      execute-procedure t-sethome
    !endif
    execute-procedure t-findname
    !if &seq %fname ""
      2 goto-mark
      set $search %tmps
      write-message "[Not a filed fold]"
    !else
      ;{{{  unfile fold
      set $curcol %psn
      set-mark
      next-line
      fold-region
      enter-fold
      !force insert-file %fname
      !if $status
              kill-to-end-of-line
              delete-next-character
              set $search %tmps
              exit-fold
              end-of-line
              yank
              shell-command &cat "rm " %fname
              write-message "[File unfolded]"
      !else
             exit-fold
             remove-fold
             set $search %tmps
             set $cmode %tmode
             write-message "[Failed to unfile fold]"
      !endif
      ;}}}
    !endif
  !endm

  ;}}}
  ;{{{  store-procedure t-filed
  store-procedure t-filed
    !if &seq $ltype LSOFOLD
      set %occ  &or ¬ &equal &sin $cfname ".occ" 0 ¬ &equal &sin $cfname ".inc" 0
      set %mst  ¬ &equal &sin $cfname ".mst" 0
      !if &equal t-depth 0
        execute-procedure t-sethome
      !endif
      set %tmps    $search
      set %tmode   $cmode
      set %tmpbuf  $cbufname
      enter-fold
      set-mark
      end-of-file
      copy-region
      set %fname &cat @"file name ?" %home
      !if ¬ &exist %filename
        ;{{{  ok
        !force find-file %fname
        yank
        select-buffer %tmpbuf
        kill-region
        insert-string " "
        !if %occ
          insert-string "#INCLUDE ~""
        !else
          !if %mst
            insert-string "#EXPAND ~""
            set %fname &left %fname &sub &sin $cfname ".mst" 1
          !else
            insert-string "#include ~""
          !endif
        !endif
        insert-string &cat %fname "~""
        exit-fold
        set $search %tmps
        write-message "[Fold filed]"
        ;}}}
      !else
        select-buffer %tmpbuf
        set $search %tmps
        exit-fold
        write-message "[File already exists]"
      !endif
    !else
      write-message "[Not a fold]"
  !endm
  ;}}}
  ;{{{  store-procedure t-exit-filed
  store-procedure t-exit-filed
    set %tmps    $search
    set %tmpbuf  $cbufname
    set %fname   $cfname
    1 select-buffer "?filed"
    beginning-of-file
    !if $lwidth
      !force search-forward &cat "+" %fname
      !if $status
        forward-character
        kill-to-end-of-line
        delete-next-character
        find-file $kill
        set %t-depth &sub %t-depth 1
        set $search %tmps
        write-message "[File exited]"
      !else
        select-buffer %tmpbuf
        set $search %tmps
        write-message "[No more files to exit]"
      !endif
    !else
      select-buffer %tmpbuf
      set $search %tmps
      set %t-depth 0
      write-message "[No more files to exit]"
    !endif
  !endm

  ;}}}
  ;{{{  store-procedure t-list-filed
  store-procedure t-list-filed
    save-window
    set %tmps    $search
    set %tmpbuf  $cbufname
    set %fname   $cfname
    split-current-window
    1 select-buffer "?filed"
    end-of-file
    previous-line
    $curline resize-window
    restore-window
  !endm
  ;}}}
  ;{{{  store-procedure comment-fold
  store-procedure comment-fold
          !force enter-fold
          !if $status
                  end-of-file
                  set %endline $curline
                  beginning-of-file
                  !while &less $curline %endline
                          !if &seq $ltype LNORMAL
                                  set $curcol $lmargin
                                  insert-string "--"
                                  !force next-line
                          !else
                          !if &seq $ltype LSOFOLD
                                  open-fold
                          !else
                                  !force next-line
                          !endif
                          !endif
                  !endwhile
                  exit-fold
                  5 forward-character
                  insert-string "COMMENT "
                  write-message "[fold commented]"
          !endif
  !endm

  ;}}}
  ;{{{  store-procedure uncomment-fold
  store-procedure uncomment-fold
          !force enter-fold
          !if $status
                  add-mode magic
                  end-of-file
                  set %endline $curline
                  beginning-of-file
                  !while &less $curline %endline
                          !if &seq $ltype LNORMAL
                                  set $curcol $lmargin
                                  !if &equal &sindex $line "--" &add $curcol 1
                                          2 delete-next-character
                                  !endif
                                  !force next-line
                          !else
                          !if &seq $ltype LSOFOLD
                                  open-fold
                          !else
                                  !force next-line
                          !endif
                          !endif
                  !endwhile
                  exit-fold
                  1 replace-string "COMMENT " " "
                  delete-previous-character
                  close-fold
                  write-message "[fold un-commented]"
          !endif
  !endm

  ;}}}
  ;{{{  store-procedure auto-fold
  ; CMODE
  store-procedure auto-fold
          set-mark
          !if &band $cmode 2
            search-forward "{"
            backward-character
            goto-matching-fence
            next-line
          !else
            search-forward "~n~n"
          !endif
          fold-region
          execute-procedure copy-to-fold
          write-message "[region folded]
  !endm

  ;}}}
  ;{{{  store-procedure create-fold
  set %mkfold FALSE
  store-procedure create-fold
    !if %mkfold
            !force fold-region
            !if $status
                    write-message "[fold made]"
            !else
                    write-message "[Error making fold]"
            !endif
            set %mkfold FALSE
    !else
            !force set-mark
            !if $status
                    set %mkfold TRUE
                    write-message "[making fold]"
            !else
                    write-message "[Error making fold]"
            !endif
    !endif
  !endm
  ;}}}
!endif